Practical 2: Compartmental Models to Equations
Sam Abbott
Learning Objectives
- Know how to translate a simple model flow diagram into equations.
- Understand how changing parameter values can change model dynamics.
- Extension: Know how to use a simple model scaffold to develop a more complex model.
Outline for Session
- Set up (5 minutes)
- Explore the dynamics of a simple SEIR model (20 minutes)
- Extension exercises, to be completed in any order/combination;
- Explore the parameter space of multiple models using a web interface (25 minutes) (not R based).
- Add high and low risk latency to a SEIR model, and explore this models dynamics in comparison to the SEIR model (25 minutes) (R based).
- Translate a more realistic SHLIR model flow diagram to equations (25 minutes)(this excercise involves implementing a complex model in R).
- Session wrap up (5 minutes)
Exercise
1. A Simple SEIR Model of Tuberculosis (TB)
As a first exercise we are going to run the simple SEIR model, as seen in the design a model practical, in R. As a first step you will need to load the following packages.
library(biddmodellingcourse)For reference the SEIR model flow diagram ([1]) seen in the first practicals solutions. The equations below are a translation of this into R code.
Figure 1: An SEIR model of TB transmission, including simple demographic processes
Populations and Initialisation
We first set up the initial populations for the Susceptible (\(S_0\)), Latent (\(E_0\)), Infected (\(I\)), and Recovered (\(R\)) compartments. We have initialised the model as an early stage epidemic with a single case of TB.
inits = c(
S = 999,
E = 0,
I = 1,
R = 0
)Parameters
We then specify the model parameters (with the units being years-1), varying these parameters will impact the model dynamics.
parameters <- c(
beta = 3, # Rate of transmission
gamma = 1/5, # Rate of progression to active symptoms
tau = 1/2, # Rate of recovery
mu = 1/81 # Rate of natural mortality
)Equations
Finally we specify the model equations for each population compartment. This model incorporates simple demographic processes with a constant natural death rate from all compartments which is equal to the birth rate into the susceptible compartment.
SEIR_demo_ode <- function(t, x, params) {
## Specify model compartments
S <- x[1]
E <- x[2]
I <- x[3]
R <- x[4]
with(as.list(params),{
## Specify total population
N = S + E + I + R
## Derivative Expressions
dS = -beta * S * I / N - mu * S + mu * N
dE = beta * S * I / N - gamma * E - mu * E
dI = gamma * E - tau * I - mu * I
dR = tau * I - mu * R
## output
derivatives <- c(dS, dE, dI, dR)
list(derivatives)
})
}Simulate and Summarise
To simulate the model we specify the starting year (begin_time) and final year (end_time) and define a sequence over all intervening years. The model is then solved using deSolve::lsoda which is used within a simple wrapper function (see ?solve_ode for details). The resulting table summarises the simulation results for the first 5 years.
begin_time <- 0
end_time <- 200
times <- seq(begin_time, end_time, 1)
## see ?solve_ode for details
SEIR_sim <- biddmodellingcourse::solve_ode(model = SEIR_demo_ode,
inits = inits,
params = parameters,
times = times,
as.data.frame = TRUE)
SEIR_sim %>%
head %>%
pretty_table(caption = "First 5 years of model simulation",
label = "tab-1")| time | S | E | I | R |
|---|---|---|---|---|
| 0 | 999 | 0 | 1 | 0 |
| 1 | 996.5 | 2.306 | 0.8082 | 0.4264 |
| 2 | 993.9 | 4.253 | 1.008 | 0.8608 |
| 3 | 990.4 | 6.724 | 1.468 | 1.455 |
| 4 | 985.1 | 10.32 | 2.219 | 2.34 |
| 5 | 977.2 | 15.71 | 3.373 | 3.681 |
We then summarise the epidemic peak (epi_peak) and epidemic duration (epi_dur), along with population sizes at the end of the time period simulated.
biddmodellingcourse::summarise_model(SEIR_sim) %>%
pretty_table(caption = "SEIR model summary statistics; The final size of each population at the end of the simulation, along with the time the epidemic peak was reached, the number of infected at the epidemic peak and the duration of the epidemic")| Final size: S | Final size: E | Final size: I | Final size: R |
|---|---|---|---|
| 181 | 47 | 18 | 753 |
| Epidemic peak time | Epidemic peak | Epidemic duration |
|---|---|---|
| 18 | 141 | 1 |
Finally we plot the population in each model compartment over time.
## For an interactive graph change interactive to TRUE
biddmodellingcourse::plot_model(SEIR_sim, interactive = FALSE)
Figure 2: Plot of population over time in each SEIR model compartment
Explore
Model dynamics are parameter dependent. Even in a simplistic model like the one outlined above parameter values can greatly alter the dynamics. Answer the following questions by varying the parameters above and rerunning the model.
What is the impact of adding demographic processes (births and deaths)?
What happens when the transmission rate (beta) is reduced to 0.5?
What happens as the rate of recovery is increased?
Extensions
1. Explore the Parameter Space of Multiple Models
In order to more systematically explore the parameter space of multiple models we have provided a web app (http://seabbs.co.uk/shiny/exploreidmodels/). Use this to explore the models discussed in the previous practical and identify which parameters alter the model dynamics. What commonalities are there between different models and what generalisations can you draw from this. Try and answer the questions for the other extensions using the models provided in the web app.
Using the Web App
- Go to http://seabbs.co.uk/shiny/exploreidmodels/. You should see the following:
Figure 3: Homepage for the Explore Infectious Disease web app.
- Click on the Explore Model Dynamics tab in the menu on the left hand side. The app will now look like this:
Figure 4: Explore Model Dynamics tab for the Explore Infectious Disease web app.
- Select a model of interest from the menu, options include: SI, SEI, SEIR, and SHLIR, with or without demographic processes.
Figure 5: Select a model in the Explore Infectious Disease web app.
- Now vary parameter values using the provided sliders in the menu, you should observe the population in each compartment changing over time. Both summary tables used in the exercises above are also provided.
Figure 6: Vary parameters to explore dynamics in the Explore Infectious Disease web app.
- Model code is provided under the code tab.
Figure 6: Vary parameters to explore dynamics in the Explore Infectious Disease web app.
2. Add High and Low Risk Compartments
To make the SEIR model slightly more realistic, and therefore better able to capture the observed dynamics of TB, we are going to add a second latent population (as discussed in the solutions for practical 1). This change can be seen in the model flow diagram (Figure 7). Go back to practical 1 if you need a refresher for the motivation behind this. We have also added reinfection for the low risk latent population.
Figure 7: An SHLIR model of TB transmission, including simple demographic processes
Populations and Initialisation
As in the previous model the first step is to define the model populations. There are now two new compartments, high risk latents (H), and low risk latents (L). These replace the original latent population (E) used in the SEIR model.
SHLIR_inits = c(
S = 999,
H = 0,
L = 0,
I = 1,
R = 0
)Parameters
We add two additional parameters for the rate of progression from high to low risk latents (nu) and the rate of progression from low risk latent to active disease (gamma_L).
SHLIR_parameters <- c(
beta = 3, # Rate of transmission
gamma_H = 1/5, # Rate of progression to active symptoms from high risk latent
nu = 1/2, #Rate of progression from high to low risk latent
gamma_L = 1/100, # Rate of progression to active symptoms for low risk latent
tau = 1/2, # Rate of recovery
mu = 1/81 # Rate of natural mortality
)Equations
The code below is a starting point, fill in the missing model terms using the model flow diagram (Figure 7) and the code for the previous SEIR model as reference points.
SHLIR_demo_ode <- function(t, x, params) {
## Specify model compartments
S <- x[1]
H <- x[2]
L <- x[3]
I <- x[4]
R <- x[5]
with(as.list(params),{
## Specify total population
N = S + H + L + I + R
## Derivative Expressions
dS = -beta * S * I / N - mu * S + mu * N
## These are the new equations - fill in the remaining terms
dH = - gamma_H * H - nu * H - mu * H
dL = - beta * L * I / N - mu * L
## Hint terms are missing from this equation as well
dI = - tau * I - mu * I
dR = tau * I - mu * R
## output
derivatives <- c(dS, dH, dL, dI, dR)
list(derivatives)
})
}Simulate and Summarise
Simulation is the same as for the previous model. Does the simulation of your improved model make sense? Evaluate the summary tables and plot of model populations over time.
begin_time <- 0
end_time <- 200
SHILR_times <- seq(begin_time, end_time, 1)
## see ?solve_ode for details
SHLIR_sim <- biddmodellingcourse::solve_ode(model = SHLIR_demo_ode,
inits = SHLIR_inits,
params = SHLIR_parameters,
times = SHILR_times,
as.data.frame = TRUE)
SHLIR_sim %>%
head %>%
pretty_table(caption = "First 5 years of SHLIR model simulation",
label = "tab-1")biddmodellingcourse::summarise_model(SHLIR_sim) %>%
pretty_table(caption = "SHLIR model summary statistics; The final size of each population at the end of the simulation, along with the time the epidemic peak was reached, the number of infected at the epidemic peak and the duration of the epidemic")## For an interactive graph change interactive to TRUE
biddmodellingcourse::plot_model(SHLIR_sim, interactive = FALSE)Explore
Test your changes by setting
nu = 0and all other parameters to be the same as for the SEIR model. If everything is working correctly both models should give the same output.What has the impact of adding the second latent population been?
3. Translate a more realistic SHLIR model flow diagram to equations
As an advanced extension exercise now translate a more complex SHLIR model flow diagram (Figure 8), with risk groups, treatment, and reinfection for those who have recovered from active disease (Hint: First implement the model without risk groups and then add this in once everything else is working as expected). Whilst many realistic TB models use age structure in the interests of time do not include this (if you are interested in discussing how you would include this talk to your instructors or contact me). For the motivation behind this model see practical 1.
Figure 8: A realistic SHLIR model of TB transmission, including simple demographic processes
Figure 8 does not include the interaction between the high and low risk subgroups as this is through the force of infection. The force of infection is defined as,
\[ \lambda_i = \beta \sum_{j = L, H}M_{ij}I_j \]
Where \(\lambda_i\) is the force of infection in each risk group (\(i = L, H\)) and \(M_{LH}\) is the mixing rate between risk groups. It is assumed that within group contact rates are equivalent and defined such that,
\[ M_{ii} = 1 \]
It is also assumed that the between group contact rates are defined as (where \(i \neq j\)),
\[ M_{ij} = 0.1 \]
The code for an SEIR model has been supplied, along with all the required simulation and plotting functions. It is suggested that you add complexity sequentially and test the effects on the model dynamics as you go. The first step is to recreate the SHLIR model used above. If you are new to R or are struggling with this exercise feel free to move on to the next exercise (which does not use R).
Populations and Initialisation
The new populations have been added for you. The population has now been split between low and high risk populations, with the only infectious case being in the high risk population.
real_SHLIR_inits = c(
# General population
S = 800,
H = 0,
L = 0,
I = 0,
Tr = 0,
R = 0,
## High risk population
S_H = 199,
H_H = 0,
L_H = 0,
I_H = 1,
Tr_H = 0,
R_H = 0
)Parameters
The required model parameters have been defined for you (with the units being years-1). The only new parameters are the between group mixing (M), the proportion that are born high risk (p), and the transmission probability in those considered to be high risk (beta_H).
real_SHLIR_parameters <- c(
beta = 3, # Rate of transmission
beta_H = 6, # High risk rate of transmission
gamma_H = 1/5, # Rate of progression to active symptoms from high risk latent
nu = 1/2, #Rate of progression from high to low risk latent
gamma_L = 1/100, # Rate of progression to active symptoms for low risk latent
epsilon = 1/3, # Rate of treatment
tau = 1/2, # Rate of recovery
mu = 1/81, # Rate of natural mortality
p = 0.2, # proportion of new births that are high risk
M = 0.2 # Between group mixing
)Equations
Update the model equations using the model flow diagram above. The comments in the code given hints as to where changes need to be made. The equations for the low risk population have been provided for you.
real_SHLIR_demo_ode <- function(t, x, params) {
## Specify model compartments
## The compartments for the low risk population have been provided
## Add the high risk population
## Don't forget to update indexing for x. Compare the previous two models for a hint.
S <- x[1]
H <- x[2]
L <- x[3]
I <- x[4]
Tr <- x[5]
R <- x[6]
with(as.list(params),{
## Specify total population
N = S + H + L + I + Tr + R + S_H + H_H + L_H + I_H + Tr_H + R_H
## Force of infection
## The force of infetion in the low risk population has been provided for you
foi <- beta * I / N + M * beta_H * I_H / N
## Add the high risk force of infection here
foi_H <-
## Derivative Expressions
## General population - provided for you
## Compare these equations from those used for the previous models
dS = -S * foi - mu * S + (1 - p) * mu * N
dH = (S + L + R) * foi - gamma_H * H - nu * H - mu * H
dL = nu * H - L * foi - gamma_L * L - mu * L
dI = gamma_H * H + gamma_L * L - epsilon * I - mu * I
dTr = epsilon * I - tau * Tr - mu * Tr
dR = tau * Tr - R * foi - mu * R
## High risk population
## Copy the equations used above for the low risk population
## Convert them to be in the high risk population
## output
derivatives <- c(dS, dH, dL, dI, dTr, dR, dS_H, dH_H, dL_H, dI_H, dTr_H, dR_H)
list(derivatives)
})
}Simulate and Summarise
Simulate the new model as previously.
begin_time <- 0
end_time <- 200
real_SHLIR_times <- seq(begin_time, end_time, 1)
## see ?solve_ode for details
real_SHLIR_sim <- biddmodellingcourse::solve_ode(model = real_SHLIR_demo_ode,
inits = real_SHLIR_inits,
params = real_SHLIR_parameters,
times = real_SHLIR_times,
as.data.frame = TRUE)
real_SHLIR_sim %>%
head %>%
pretty_table(caption = "First 5 years of model simulation",
label = "tab-real_SHLIR")biddmodellingcourse::summarise_model(real_SHLIR_sim) %>%
pretty_table(caption = "Realistic SHLIR model summary statistics; The final size of each population at the end of the simulation, along with the time the epidemic peak was reached, the number of infected at the epidemic peak and the duration of the epidemic")## For an interactive graph change interactive to TRUE
biddmodellingcourse::plot_model(real_SHLIR_sim, interactive = FALSE)Explore
Test your changes by setting all the parameters to be the same as in the SHLIR model.
What happens when one group has a much higher transmission probability (use the default settings for all other parameters), compared to when the transmission probability is the same for both groups?
What is the impact of varying the mixing between high and low risk groups for the above scenario?
References
1 Brooks-Pollock E, Cohen T, Murray M. The impact of realistic age structure in simple models of tuberculosis transmission. PLoS One 2010;5:3–8. doi:10.1371/journal.pone.0008479